Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue30/crossref/DbCrCode/DbCrossF.pas

Pascal/Delphi Source File | 1997-11-19 | 6.6 KB | 225 lines

unit DbCrossF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, StdCtrls;

type
  TDbCrossForm = class(TForm)
    TableCustomers: TTable;
    TableOrders: TTable;
    TableItems: TTable;
    BtnGenerate: TButton;
    DataSource1: TDataSource;
    TableCustomersCustNo: TFloatField;
    TableCustomersCompany: TStringField;
    TableCustomersAddr1: TStringField;
    TableCustomersAddr2: TStringField;
    TableCustomersCity: TStringField;
    TableCustomersState: TStringField;
    TableCustomersZip: TStringField;
    TableCustomersCountry: TStringField;
    TableCustomersPhone: TStringField;
    TableCustomersFAX: TStringField;
    TableCustomersTaxRate: TFloatField;
    TableCustomersContact: TStringField;
    TableCustomersLastInvoiceDate: TDateTimeField;
    DataSource2: TDataSource;
    TableOrdersOrderNo: TFloatField;
    TableOrdersCustNo: TFloatField;
    TableOrdersSaleDate: TDateTimeField;
    TableOrdersShipDate: TDateTimeField;
    TableOrdersEmpNo: TIntegerField;
    TableOrdersShipToContact: TStringField;
    TableOrdersShipToAddr1: TStringField;
    TableOrdersShipToAddr2: TStringField;
    TableOrdersShipToCity: TStringField;
    TableOrdersShipToState: TStringField;
    TableOrdersShipToZip: TStringField;
    TableOrdersShipToCountry: TStringField;
    TableOrdersShipToPhone: TStringField;
    TableOrdersShipVIA: TStringField;
    TableOrdersPO: TStringField;
    TableOrdersTerms: TStringField;
    TableOrdersPaymentMethod: TStringField;
    TableOrdersItemsTotal: TCurrencyField;
    TableOrdersTaxRate: TFloatField;
    TableOrdersFreight: TCurrencyField;
    TableOrdersAmountPaid: TCurrencyField;
    TableItemsOrderNo: TFloatField;
    TableItemsItemNo: TFloatField;
    TableItemsPartNo: TFloatField;
    TableItemsQty: TIntegerField;
    TableItemsDiscount: TFloatField;
    EditPath: TEdit;
    Label1: TLabel;
    TableParts: TTable;
    TableItemsPart: TStringField;
    TablePartsPartNo: TFloatField;
    TablePartsVendorNo: TFloatField;
    TablePartsDescription: TStringField;
    TablePartsOnHand: TFloatField;
    TablePartsOnOrder: TFloatField;
    TablePartsCost: TCurrencyField;
    TablePartsListPrice: TCurrencyField;
    ButtonMain: TButton;
    ButtonCross: TButton;
    procedure BtnGenerateClick(Sender: TObject);
    procedure ButtonMainClick(Sender: TObject);
    procedure ButtonCrossClick(Sender: TObject);
  end;

var
  DbCrossForm: TDbCrossForm;

implementation

{$R *.DFM}

uses
  Shellapi, HtmlData;

procedure TDbCrossForm.BtnGenerateClick(Sender: TObject);
var
  HtmlCust, HtmlOrd, HtmlItem, HtmlParts: THtmlData;
  HtmlMem: THtmlStrings;
  ListOfLists: TStringList;
  Index: Integer;
begin
  // initialize
  Screen.Cursor := crHourglass;

  // create the string lists
  HtmlCust := THtmlData.Create (TableCustomers);
  HtmlOrd := THtmlData.Create (TableOrders);
  HtmlItem := THtmlData.Create (TableItems);
  HtmlParts := THtmlData.Create (TableParts);
  ListOfLists := TStringList.Create;

  try
    // the main file (customers)
    HtmlCust.AddHeader ('All the Customers');

    // for each customer
    TableCustomers.First;
    while not TableCustomers.EOF do
    begin
      // add a row to the html customers table
      HtmlCust.AddTableRow ('Cust');

      // orders for each customer
      HtmlOrd.AddHeader (
        TableCustomersCompany.AsString +
        ' Orders');

      // for each order
      TableOrders.First;
      while not TableOrders.EOF do
      begin
        // add the data of the current order
        HtmlOrd.AddTableRow ('Ord');

        // items of each order
        HtmlItem.AddHeader (
          TableCustomersCompany.AsString + ' Order No. ' +
          TableOrders.FieldByName('OrderNo').AsString);

        while not TableItems.EOF do
        begin
          // add the data of the current item
          HtmlItem.AddTableRow ('');

          // search the part in the cross reference
          Index := ListOfLists.IndexOf (
            TableItemsPartNo.AsString);
          // if not found create a new entry
          if Index < 0 then
          begin
            HtmlMem := THtmlStrings.Create;
            HtmlMem.AddHeader ('Part: ' +
              TableItemsPart.AsString);
            Index := ListOfLists.AddObject (
              TableItemsPartNo.AsString, HtmlMem);
          end;
          // add the reference to the list
          THtmlStrings (ListOfLists.Objects[Index]).
            Add ('<a href="Ord' +
              TableItemsOrderNo.AsString + '.htm">' +
              TableCustomersCompany.AsString +
              ' Order No. ' +
              TableOrders.FieldByName('OrderNo').AsString +
              '</a><p>');
          TableItems.Next;
        end;

        // save the html file with the items of the order
        HtmlItem.AddFooter;
        HtmlItem.SaveToFile (EditPath.Text + 'Ord' +
          TableOrders.FieldByName('OrderNo').AsString +
          '.htm');
        TableOrders.Next;
      end;
      // save the html file with the orders of the customer
      HtmlOrd.AddFooter;
      HtmlOrd.SaveToFile (EditPath.Text + 'Cust' +
        TableCustomersCustNo.AsString + '.htm');
      TableCustomers.Next;
    end;

    HtmlCust.AddFooter;
    HtmlCust.SaveToFile (EditPath.Text + 'main.htm');

    // output the cross reference files
    for Index := 0 to ListOfLists.Count - 1 do
    begin
      HtmlMem := THtmlStrings (ListOfLists.Objects[Index]);
      HtmlMem.AddFooter;
      HtmlMem.SaveToFile (EditPath.Text + 'Itx' +
        ListOfLists [Index] + '.htm');
      HtmlMem.Free;
    end;

    // generate the index of the cross reference
    HtmlParts.AddHeader ('Parts Cross Reference');
    TableParts.First;
    while not TableParts.EOF do
    begin
      // add a row to the html customers table
      HtmlParts.AddTableRow ('Itx');
      TableParts.Next;
    end;
    HtmlParts.AddFooter;
    HtmlParts.SaveToFile (EditPath.Text +
      'Parts.htm');

  finally
    HtmlCust.Free;
    HtmlOrd.Free;
    HtmlItem.Free;
    HtmlParts.Free;
    ListOfLists.Free;
    Beep;
    Screen.Cursor := crDefault;
  end;
end;

procedure TDbCrossForm.ButtonMainClick(Sender: TObject);
begin
  // open the main file with the default browser
  ShellExecute (Handle, 'open',
    pChar (EditPath.Text + 'main.htm'),
    '', '', sw_ShowNormal);
end;

procedure TDbCrossForm.ButtonCrossClick(Sender: TObject);
begin
  // open the main file with the default browser
  ShellExecute (Handle, 'open',
    pChar (EditPath.Text + 'parts.htm'),
    '', '', sw_ShowNormal);
end;

end.